home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tpu55a.zip
/
TPUAMS1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-08-10
|
30KB
|
930 lines
{$D+,O+,S+,R-,L+}
Unit TPUAMS1;
(*****************)
(**) INTERFACE (**)
(*****************)
USES Dos;
TYPE
Str2 = String[2]; Str4 = String[4];
RngB = 0..65534;
RngW = 0..32766;
AryB = ARRAY[rngb] OF Byte;
AryW = ARRAY[rngw] OF Word;
SrcNam = String[12];
LexNam = String[63];
HdrAry = ARRAY[0..3] OF Char;
LL = Word; { Local Scope Pointers (offsets) }
LG = RECORD { Global Scope Pointers to Other Units }
UntLL : LL; { Local to containing unit }
UntId : LL; { Local to external unit }
END;
{ The following Record is the Header and Locator for a Unit File } {.CP26}
UnitHeadPtr = ^UnitHeader;
UnitHeader = RECORD
FilHd : HdrAry; { +00 : = 'TPU6' }
Fillr : HdrAry; { +04 : = $00000000 }
UDirE : LL; { +08 : to Dictionary Head-This Unit }
UGHsh : LL; { +0A : to Interface Hash Header }
UHPrc : LL; { +0C : to PROC Map }
UHCsg : LL; { +0E : to CSeg Map }
UHDsT : LL; { +10 : to DSeg Map-Typed CONST's }
UHDsV : LL; { +12 : to DSeg Map-GLOBAL Variables }
URULt : LL; { +14 : to Donor Unit List }
USRCF : LL; { +16 : to Source file List }
UDBTS : LL; { +18 : to Debug Trace Step Controls }
UndNC : LL; { +1A : to end non-code part of Unit }
ULCod : Word; { +1C : Size of Code }
ULTCon: Word; { +1E : Size of Typed Constant Data }
ULPtch: Word; { +20 : Size of Relo Patch List }
Unknx : Word; { +22 : Number of Virtual Objects??? }
ULVars: Word; { +24 : Size of GLOBAL VAR Data }
UHash2: LL; { +26 : to Debug Hash Header }
UOvrly: Word; { +28 : Number of Procs to Overlay?? }
UVTPad: ARRAY[0..10]
OF Word; { +2A : Reserved for Future Expansion ? }
END; { UnitHeader }
{ The Records below provide access to the PROC Map } {.CP12}
ProcMapRecPtr = ^ProcMapRec;
ProcMapRec = RECORD
CSegOfs : Word; { offset within CSeg Map; $FFFF if null }
CSegJmp : Word; { offset to entry point; $FFFF if null }
END {ProcMapRec};
ProcMapPtr = ^ProcMapTab;
ProcMapTab = RECORD
ProcMap : ARRAY[0..1] OF ProcMapRec; { model of PROC Map }
END; {ProcMapTab}
{ The Records below provide access to the CODE Map } {.CP14}
CSegMapRecPtr = ^CSegMapRec;
CSegMapRec = RECORD
CSegWd0 : Word; { purpose is unknown }
CSegCnt : Word; { byte count of module code }
CSegRel : Word; { byte count of module Relo List }
CSegTrc : Word; { Trace table offset or $FFFF }
END; {CSegMapRec}
CSegMapTabPtr = ^CSegMapTab;
CSegMapTab = RECORD
CSegMap : ARRAY[0..1] OF CSegMapRec; { model of CSeg Map }
END; {CSegMapTab}
{ The Records below provide access to the CONST DSeg Map } {.cp14}
DSegMapRecPtr = ^DSegMapRec;
DSegMapRec = RECORD
DSegWd0 : Word; { purpose is unknown }
DSegCnt : Word; { byte count of data block }
DSegRel : Word; { byte count of data Relo List }
DSegOwn : LL; { To owner scope }
END; {DSegMapRec}
DSegMapTabPtr = ^DSegMapTab;
DSegMapTab = RECORD
DSegMap : ARRAY[0..1] OF DSegMapRec; { model of DSeg Map }
END; {DSegMapTab}
{ The Record below is one entry in the Relo List }{.CP15}
ReloListEntryPtr = ^ReloListEntry;
ReloListEntry = RECORD
RloDnr : Byte; { Donor Unit Offset }
RloFlg : Byte; { Entry Format Flag }
RloWd1 : Word; { Offset to Map Table }
RloWd2 : Word; { Effective Address Adjuster }
RloOfs : Word; { offset to patch point in code/data block }
END; {ReloListEntry}
ReloListPtr = ^ReloListVector;
ReloListVector = RECORD
ReloList : ARRAY[0..1] OF ReloListEntry; { model of Relo List }
END; {ReloListVector}
{ The Record below maps the Dictionary Header in Turbo Units } {.CP08}
DictHeadPtr = ^ DictHeadRecd;
DictHeadRecd = RECORD
HLink : LL; { Hash Chain Link; Resolves Collisions }
DForm : Char; { Symbol Type; See StubRecord for types}
DSymb : LexNam; { Worst-Case Symbol Size (UPPER-CASE) }
END;
{ The Record Below maps the Dictionary Stubs in Turbo Units } {.CP10}
DictStubPtr = ^ DictStubRcd;
DictStubRcd = RECORD
CASE Char OF
'P': ( { --- For Untyped Constants --- }
DTG : LG; { to type descriptor }
val1 : Word; { value of constant - LO Word }
val2 : Word); { (size varies) - HI Word }
'Y': ( { ----- For UNIT Entries ------ } {.CP05}
PP : Word; { unknown use; normally zero }
SIG : Word; { Speculate Signature Word }
UA : LL; { to next Unit in List (SUCC) }
UZ : LL); { to prior Unit in List (PRED) }
'O', { ---- Label Declaratives ----- } {.CP05}
'T', { ---- Standard Procedures ---- }
'U', { ---- Standard Functions ---- }
'V': ( { ---- Standard "NEW" F/P ---- }
D : Word); { semantics not precisely known }
'W': ( { ------- Standard Ports ------ } {.CP02}
M : Byte); { 0=Byte Array, 1=Word Array }
'Q', { -------- Named Types -------- } {.CP03}
'X': ( { ----- External Variables ---- }
QTG : LG); { to type descriptor }
'R': ( { -- Variable, Field, Object -- } {.CP22}
RH : Byte; { allocation method codes: }
{ 0 = Global Variables in DS }
{ 1 = Typed Constants in DS }
{ 2 = LOCAL Variables & VALUE }
{ Parameters put on Stack }
{ 6 = ADDRESS Parameters-Stack }
{ 8 = Allocate in Record/Object }
ROfs : Word; { allocation offset in bytes }
ROB : LL; { *** see notes below }
RLG : LG); { to Type Descriptor }
{ Variables & Formal Parameters have LL pointing to
Containing scope or zero if Global.
Record Fields have LL to next Field; zero if none.
Object Fields/Methods have LL to next field/method
in order of declaration or zero if none.
Typed Constants have offset in Data Map that
locates text of Typed Constant Data. }
'S': ( { ------ User Subprograms ----- } {.CP24}
TCod : BYte; { type code - Bit encoded ????? }
{ xxxxxxx1 = INTERFACE declared }
{ xxxxxx1x = INLINE Declarative }
{ xxxx1xxx = .OBJ module code }
{ xxx1xxxx = METHOD }
{ x011xxxx = Constructor METHOD }
{ x101xxxx = Destructor METHOD }
BCod : Word; { Code byte count if INLINE, }
{ else, offset to PROC Map }
Scop : LL; { to containing scope or zero }
SHsh : LL; { to local scope hash table }
SVMO : Word; { VMT offset used by METHOD }
Smth : LL); { to next METHOD for Object }
{ Notes: "Smth" is followed immediately by a Type }
{ Descriptor ($06). INLINE Declarative code }
{ Bytes then follow (if any). }
END;
{ The Record below maps a Formal Parameter List Entry } {.CP08}
FormalParmRcd = RECORD
TDG : LG; { to type descriptor for parameter }
ALM : Byte; { passing model; 2=Value, 6=Address }
END;
InlineLst = ARRAY[0..1] OF Word; { model of INLINE code }
{ The Record below maps the Type Descriptors in Turbo Units } {.CP07}
TypePtr = ^TypeRecd;
TypeRecd = RECORD
Typ : Byte; { Identifies the Variant Part }
TMod : Byte; { Type Qualifier }
Siz : Word; { Storage Width in Bytes }
CASE Byte OF {.CP05}
$00, { For NULL or Un-Typed Variables }
$0A, { For COMP,DOUBLE,EXTENDED,SINGLE }
$0B : (); { -------- For REAL Type -------- }
$01 : ( { ------ For ARRAY Types ------- } {.CP04}
BaseType : LG; { to TypeRecd for item arrayed }
BounDesc : LG; { to TypeRecd for array bounds }
);
$02 : ( { ------ For RECORD Types ------ } {.CP04}
RecdHash : LL; { to Hash Table for Field List }
RecdDict : LL; { to Field List Dictionary Begin }
);
$03 : ( { ------ For OBJECT Types ------ } {.CP11}
ObjtHash : LL; { to Fields & Methods Hash Table }
ObjtDict : LL; { to Fields & Methods Dictionary }
ObjtOwnr : LG; { to Parent Object Type Descript }
ObjtVMTs : Word;{ Size of VMT if Virtual Methods }
ObjtDMap : Word;{ Data Map Offset of VMT Skeletn }
ObjtVMTO : Word;{ offset in allocated object to }
{ VMT pointer; $FFFF if object }
{ has no Virtual Methods }
ObjtName : LL; { to Object Dictionary Entry }
);
$04, { ----- For FILE except TEXT ----} {.CP04}
$05: ( { ----- For TEXT file type ----- }
FileType : LG; { to TypeRecd for Base File Type }
);
$06: ( { ----- For Procedure Types ---- }
PFRes : LG; { to Function Result TD / zero }
PNPrm : Word; { Formal Parameter Count/ zero }
PFPar : ARRAY[1..2] OF FormalParmRcd
);
$07 : ( { ------- For SET Types -------- } {.CP03}
SetBase : LG; { to base type descriptor of set }
);
$08 : ( { ----- For POINTER Types ------ } {.CP03}
PtrBase : LG; { to base type descriptor }
);
$09 : ( { ------ For STRING Types ------ } {.CP04}
StrBase : LG; { to SYSTEM.CHAR type descriptor }
StrBound : LG; { to array bounds for string typ }
);
$0C, { For BYTE,INTEGER,LONGINT,SMALLINT,WORD }{.CP15}
$0D, { ------- For BOOLEAN Type ------ }
$0E, { ------- For CHAR Type --------- }
$0F : ( { ---- For Enumerated Types ----- }
LoBnd : LongInt;{ lower bound of subrange }
HiBnd : LongInt;{ upper bound of subrange }
Cmpat : LG; { to upward compatible Type desc }
);
{ The Enumerated Type Descriptor is immediately
followed by a SET Type Descriptor ($07) but we
don't know what this accomplishes. Its base type
LG points to the Enumerated Type Descriptor. }
END; { TypeRecd }
{ The Record below is a model Hash Table } {.CP08}
HashPtr = ^HashTable;
HashTable = RECORD
Bas : Word; { Base and Max Subscript of Slt * 2 }
Slt : ARRAY[0..1] { Slots in Hash Table }
OF LL;
END;
{ The Record below is an entry in the Unit Code/Data Donor List } {.CP07}
UnitDonorPtr = ^UnitDonorRec;
UnitDonorRec = RECORD
UDExxx : Word;
UDEnam : String[8]
END;
{ The Record below is an entry in the Source File List } {.CP10}
SrcFilePtr = ^SrcFileEntry;
SrcFileEntry = RECORD
SrcFlag : Byte; { 4=.PAS file, 3=.INC, 5=.OBJ }
SrcPad : Word; { no apparent use - always zero ? }
SrcTime : Word; { File Time Stamp if SrcFlag=3 or 4 }
SrcDate : Word; { File Date Stamp if SrcFlag=3 or 4 }
SrcName : SrcNam; { Varying length FileName.Extn }
END;
{ The Record below is an entry in the Trace Table } {.CP12}
TraceRecPtr = ^TraceRec;
TraceRec = RECORD
TrName : LL; { to Directory Entry of Proc/Method }
TrFill : Word; { to proc source file }
TrPfx : Word; { bytes of data in front of code }
TrBeg : Word; { Line Number of BEGIN Stmt }
TrLNos : Word; { Lines of Code to Execute in TRACE }
TrExec : ARRAY[1..2] { Model Array of bytes that map each }
OF Byte; { line of code to be traced by DEBUG }
END;
BufPtr = ^Buffer; {.CP06}
Buffer = RECORD { General Buffer Mapping }
CASE Boolean OF
True :( BufByt : AryB); { Byte Array over Buffer }
False:( BufWrd : AryW); { Word Array over Buffer }
END;
CMapRefRec = { CSeg/File/Fix-UP correlations } {.CP14}
RECORD
CmNdxC : Integer; { index to CSeg Map }
CmNdxF : LL; { offset to Source File }
CmSegL : LL; { Segment Load Point }
CmSegS : LL; { Segment Byte Count }
CmNdxR : Integer; { Index to First Fix-up Entry }
CmCntR : Integer; { Index to Final Fix-up Entry }
END;
CMapRefPtr = ^CMapRefTab;
CMapRefTab =
RECORD
CMRefs : ARRAY[0..199] OF CMapRefRec;
END;
PMapRefRec = { PROC/CSeg correlations } {.CP14}
RECORD
PmNdxP : Word; { index to PROC Map }
PmNdxC : Word; { index to CSeg Map }
PmDirN : LL; { LL to PROC name or $FFFF }
PmEntP : LL; { to PROC Entry in Segment or $FFFF}
PmSizP : Word; { PROC Length (Bytes) or 0 }
END;
PMapRefPtr = ^PMapRefTab;
PMapRefTab =
RECORD
PMRefs : ARRAY[0..199] OF PMapRefRec;
END;
VAR {.CP05}
BufPtrJob : BufPtr;
PMapC: CMapRefPtr; NMapC : Word; { Built on request }
PMapP: PMapRefPtr; NMapP : Word; { Built on request }
PROCEDURE InitJobUnit(FilNam:Dos.PathStr); {.CP25}
PROCEDURE XrefMaps(U:UnitHeadPtr);
PROCEDURE DropJobUnit;
FUNCTION PtrAdjust(Arg : Pointer; Adj: Word):Pointer;
FUNCTION FormLL(Base,Ceil:Pointer):LL;
FUNCTION HexB(Arg:byte):Str2;
FUNCTION HexW(Arg:Word):Str4;
FUNCTION AddrStub(arg : DictHeadPtr):DictStubPtr;
FUNCTION AddrHash(U : UnitHeadPtr; Hash : LL): HashPtr;
FUNCTION AddrDict(U : UnitHeadPtr; Hash : LL): DictHeadPtr;
FUNCTION AddrType(U : UnitHeadPtr; TypeLG : LG):TypePtr;
FUNCTION AddrProcType(S : DictStubPtr):TypePtr;
FUNCTION AddrNxtSrc(U : UnitHeadPtr; Arg : SrcFilePtr):SrcFilePtr;
FUNCTION AddrSrcTabOff(U : UnitHeadPtr; Offset : Word):SrcFilePtr;
FUNCTION CountPMapSlots(U : UnitHeadPtr):Integer;
FUNCTION AddrPMapTab(U : UnitHeadPtr):ProcMapPtr;
FUNCTION CountCMapSlots(U : UnitHeadPtr):Integer;
FUNCTION AddrCMapTab(U : UnitHeadPtr):CSegMapTabPtr;
FUNCTION CountDMapSlots(U : UnitHeadPtr):Integer;
FUNCTION AddrDMapTab(U : UnitHeadPtr):DSegMapTabPtr;
FUNCTION AddrTraceTab(U : UnitHeadPtr):TraceRecPtr;
FUNCTION GetTrExecSize(T : TraceRecPtr):Integer;
FUNCTION AddrNxtTrace(U : UnitHeadPtr; T : TraceRecPtr):TraceRecPtr;
FUNCTION AddrFixUps(U : UnitHeadPtr):ReloListPtr;
FUNCTION AddrLGUnit(U : UnitHeadPtr; TypeLG : LG):DictHeadPtr;
{ ============================================================= } {.CP27}
(**********************)
(**) IMPLEMENTATION (**)
(**********************)
TYPE
Fstats = RECORD
Size : Longint;
Path : Dos.PathStr;
END;
CONST
TurboId6 : HdrAry = 'TPU6';
NullOfs : Word = $FFFF;
VAR
TPFile : File;
CMapSiz,
PMapSiz,
SizRefBfr,
SizJobBfr : Word;
BufPtrRef : BufPtr;
JobPath : Dos.PathStr;
{ Procedure Below Traps Pointer Violations } {.CP10}
PROCEDURE CheckPtrs(U,V:Pointer);
BEGIN
IF (U = Nil) OR (V = Nil) OR (Seg(U^) <> Seg(V^)) THEN
BEGIN
WriteLn('Pointer Violation');
Halt(1)
END
END; {CheckPtrs}
{ Function Below Computes an LL from two Pointers } {.CP09}
FUNCTION FormLL(Base,Ceil:Pointer):LL;
BEGIN
CheckPtrs(Base,Ceil);
IF Ofs(Base^) > Ofs(Ceil^)
THEN FormLL := LL(Ofs(Base^)-Ofs(Ceil^))
ELSE FormLL := LL(Ofs(Ceil^)-Ofs(Base^));
END;
{ Function Below Adjusts Pointer Values by Offsets } {.CP04}
FUNCTION PtrAdjust(Arg : Pointer; Adj: Word):Pointer;
BEGIN PtrAdjust := Ptr(Seg(Arg^),Ofs(Arg^) + Adj) END;
{ Function Below Finds The Stub Belonging to a Dictionary Header } {.CP05}
FUNCTION AddrStub(Arg : DictHeadPtr):DictStubPtr;
CONST PrefixSize = SizeOf(LL)+SizeOf(Char) + 1;
BEGIN AddrStub := PtrAdjust(Arg,PrefixSize + Ord(Arg^.DSymb[0])) END;
{ Function Below Gets Pointer to Hash Table } {.CP04}
FUNCTION AddrHash(U : UnitHeadPtr; Hash : LL): HashPtr;
BEGIN AddrHash := HashPtr(PtrAdjust(U,Hash)) END;
{ Function Below Gets Pointer to Dictionary Entry using LL } {.CP04}
FUNCTION AddrDict(U : UnitHeadPtr; Hash : LL): DictHeadPtr;
BEGIN AddrDict := DictHeadPtr(PtrAdjust(U,Hash)) END;
{ Function Below Gets Pointer to Type Descriptor if Local to Unit } {.CP12}
FUNCTION AddrType(U : UnitHeadPtr; TypeLG : LG):TypePtr;
VAR D:DictHeadPtr; S:DictStubPtr; R:LL;
BEGIN
D := AddrDict(U,U^.UDirE);
S := AddrStub(D);
R := FormLL(U,S);
IF R = TypeLG.UntId
THEN AddrType := TypePtr(PtrAdjust(U,TypeLG.UntLL))
ELSE AddrType := Nil
END;
{ Function Below Gets Pointer to Unit Descriptor for Type via LG } {.CP21}
FUNCTION AddrLGUnit(U : UnitHeadPtr; TypeLG : LG):DictHeadPtr;
VAR D:DictHeadPtr; S:DictStubPtr; R:LL;
BEGIN
D := AddrDict(U,U^.UDirE);
S := AddrStub(D);
R := FormLL(U,S);
IF (R <> 0) THEN
IF (TypeLG.UntID <> R) THEN
REPEAT
D := AddrDict(U,S^.UA);
IF D^.DForm <> 'Y' THEN R := 0 ELSE
BEGIN
S := AddrStub(D);
R := FormLL(U,S);
END;
UNTIL (R = TypeLG.UntID) OR (R = 0);
IF R <> 0 THEN AddrLGUnit := D
ELSE AddrLGUnit := Nil;
END;
{ Function Below Gets Pointer to Procedure Stub Type Descriptor }{.CP04}
FUNCTION AddrProcType(S : DictStubPtr):TypePtr;
BEGIN AddrProcType := TypePtr(PtrAdjust(@S^.Smth,SizeOf(S^.Smth))) END;
{ Function Below Gets Pointer to Next Entry in Source File List } {.CP21}
FUNCTION AddrNxtSrc(U : UnitHeadPtr; Arg : SrcFilePtr):SrcFilePtr;
VAR J : LL; S : SrcFilePtr;
BEGIN
J := 0;
IF Arg = Nil THEN AddrNxtSrc := Nil ELSE
BEGIN
J := FormLL(U,Arg);
IF J < U^.USRCF
THEN AddrNxtSrc := Nil ELSE
IF NOT (J < U^.UDBTS)
THEN AddrNxtSrc := Nil ELSE
BEGIN
S := SrcFilePtr(PtrAdjust(Arg,8 + Ord(Arg^.SrcName[0])));
IF FormLL(U,S) < U^.UDBTS
THEN AddrNxtSrc := S
ELSE AddrNxtSrc := Nil
END
END
END;
{ Function Below Gets Pointer to Source File List Entry at Offset }{.CP09}
FUNCTION AddrSrcTabOff(U : UnitHeadPtr; Offset : Word):SrcFilePtr;
BEGIN
WITH U^ DO
IF (USRCF+Offset) < UDBTS
THEN AddrSrcTabOff := SrcFilePtr(PtrAdjust(U,USRCF+Offset))
ELSE AddrSrcTabOff := Nil
END;
{ Function Counts Number of Slots in PROC Map Table } {.CP06}
FUNCTION CountPMapSlots(U : UnitHeadPtr):Integer;
BEGIN
CountPMapSlots := (U^.UHCsg-U^.UHPrc) DIV SizeOf(ProcMapRec);
END;
{ Function Gets Address of PROC Map Table } {.CP08}
FUNCTION AddrPMapTab(U : UnitHeadPtr):ProcMapPtr;
BEGIN
IF CountPMapSlots(U) > 0
THEN AddrPMapTab := ProcMapPtr(PtrAdjust(U,U^.UHPrc))
ELSE AddrPMapTab := Nil
END;
{ Function Counts Number of Slots in CSeg Map Table } {.CP06}
FUNCTION CountCMapSlots(U : UnitHeadPtr):Integer;
BEGIN
WITH U^ DO CountCMapSlots := (UHDsT-UHCsg) DIV SizeOf(CSegMapRec);
END;
{ Function Gets Address of CSeg Map Table } {.CP08}
FUNCTION AddrCMapTab(U : UnitHeadPtr):CSegMapTabPtr;
BEGIN
IF CountCmapSlots(U) > 0
THEN AddrCMapTab := CSegMapTabPtr(PtrAdjust(U,U^.UHCsg))
ELSE AddrCMapTab := Nil
END;
{ Function Counts Number of DSeg Map Slots } {.CP06}
FUNCTION CountDMapSlots(U : UnitHeadPtr):Integer;
BEGIN
WITH U^ DO CountDMapSlots := (UHDsV - UHDsT) DIV SizeOf(DSegMapRec)
END;
{ Function Gets Address of DSeg Map Table } {.CP08}
FUNCTION AddrDMapTab(U : UnitHeadPtr):DSegMapTabPtr;
BEGIN
IF CountDMapSlots(U) > 0
THEN AddrDMapTab := DSegMapTabPtr(PtrAdjust(U,U^.UHDsT))
ELSE AddrDMapTab := Nil
END;
{ Function Below Gets Pointer to 1st Trace Table Entry or Nil } {.CP08}
FUNCTION AddrTraceTab(U : UnitHeadPtr):TraceRecPtr;
BEGIN
IF U^.UDBTS = U^.UndNC
THEN AddrTraceTab := Nil
ELSE AddrTraceTab := TraceRecPtr(PtrAdjust(U,U^.UDBTS))
END; {AddrTraceTab}
{ Function Below Gets Byte Count in TrExec Array } {.CP20}
FUNCTION GetTrExecSize(T : TraceRecPtr):Integer;
VAR i,k : Integer;
BEGIN
IF T = Nil THEN GetTrExecSize := 0 ELSE
BEGIN
k := T^.TrLNos;
i := 1;
WHILE i <= k DO BEGIN
IF T^.TrExec[i] = $80 THEN
BEGIN
Inc(k);
Inc(i)
END;
Inc(i)
END;
GetTrExecSize := k;
END;
END;
{ Function Below Gets Pointer to next Trace Table Entry or Nil } {.CP14}
FUNCTION AddrNxtTrace(U : UnitHeadPtr; T : TraceRecPtr):TraceRecPtr;
VAR k : Integer;
BEGIN
IF T = Nil THEN AddrNxtTrace := Nil ELSE
BEGIN
k := GetTrExecSize(T);
T := TraceRecPtr(PtrAdjust(@T^.TrExec[1],LL(k)));
IF FormLL(U,T) >= U^.UndNC
THEN AddrNxtTrace := Nil
ELSE AddrNxtTrace := T
END
END; {AddrNxtTrace}
{ Function Below Gets Pointer to 1st Fixup Table Entry or Nil } {.CP13}
FUNCTION AddrFixUps(U : UnitHeadPtr):ReloListPtr;
VAR j : Word;
BEGIN
IF U^.ULPtch = 0 THEN AddrFixUps := Nil ELSE
WITH U^ DO BEGIN
j := (UndNC + $F) AND $FFF0;
j := (ULCod + $F) AND $FFF0 + j;
j := (ULTCon + $F) AND $FFF0 + j;
AddrFixUps := Ptr(Seg(U^),Ofs(U^) + j)
END
END; {AddrFixUps}
{ Function Below Converts a byte to Printable Hex } {.CP05}
FUNCTION HexB(arg:byte): Str2;
CONST HexTab : ARRAY[0..15] OF Char = '0123456789ABCDEF';
BEGIN HexB := HexTab[arg SHR 4] + HexTab[arg AND $F] END;
{ Function Below Converts a Word to Printable Hex in Dump Mode } {.CP04}
FUNCTION HexW(arg:Word): Str4;
BEGIN HexW := HexB(HI(arg)) + HexB(LO(arg)) END;
PROCEDURE CloseMapRefTab; {.CP06}
BEGIN
IF PMapC <> Nil THEN FreeMem(PMapC,CMapSiz);
IF PMapP <> Nil THEN FreeMem(PMapP,PMapSiz);
PMapC := Nil; CMapSiz := 0; NMapC := 0;
PMapP := Nil; PMapSiz := 0; NMapP := 0;
END;
{.CP11} {
The Following Procedure may be called to collect and
collate all information about PROCS and CSEGS into a
pair of dynamic arrays for use in Disassembly. What
is determined is PROC Name, load address and size,
CSEG load address, size, fix-up lists and names of
files that furnish the CSEGS. Storage used is only
10-bytes per PROC and 12-bytes per CSeg.
}
PROCEDURE XrefMaps(U:UnitHeadPtr); {.CP03}
PROCEDURE ScanHash(HLL : LL);
PROCEDURE ScanProc(D : DictHeadPtr; DLL : LL); {.CP11}
VAR S : DictStubPtr; i : Integer;
BEGIN
S := AddrStub(D);
IF (S^.TCod AND $02) = 0 THEN
BEGIN
i := S^.BCod DIV SizeOf(ProcMapRec);
PMapP^.PmRefs[i].PmDirN := DLL;
IF S^.SHsh <> 0 THEN ScanHash(S^.SHsh);
END;
END;
PROCEDURE ScanType(D : DictHeadPtr); {.CP09}
VAR T : TypePtr; S : DictStubPtr;
BEGIN
S := AddrStub(D);
T := AddrType(U,S^.QTG);
IF T <> Nil THEN {Type Defined Locally}
IF T^.Typ = $03 {Object may have methods}
THEN ScanHash(T^.ObjtHash);
END;
PROCEDURE ScanChain(DLL : LL); {.CP09}
VAR D : DictHeadPtr;
BEGIN
WHILE DLL <> 0 DO BEGIN
D := AddrDict(U,DLL);
IF D^.DForm = 'S' THEN ScanProc(D,DLL) ELSE
IF D^.DForm = 'Q' THEN ScanType(D);
DLL := D^.HLink;
END;
END;
VAR HLim, I, j : LL; H : HashPtr; {.CP10}
BEGIN
H := AddrHash(U,HLL);
HLim := H^.Bas DIV SizeOf(LL);
WITH H^ DO FOR I := 0 TO HLim DO BEGIN
j := Slt[i];
IF j <> 0
THEN ScanChain(Slt[i]);
END;
END; {ScanHash}
PROCEDURE SortPMap(PmCnt:Word); {Slow & simple} {.CP21}
VAR i,j,k : Word; W : PMapRefRec;
BEGIN
I := 0;
WITH PMapP^ DO REPEAT
J := I + 1;
K := I;
WHILE J < PmCnt DO BEGIN
IF PMRefs[J].PmEntP < PMRefs[K].PmEntP
THEN K := J;
Inc(J);
END;
IF K <> I THEN
BEGIN
W := PMRefs[I];
PMRefs[I] := PMRefs[K];
PMRefs[K] := W;
END;
Inc(I);
UNTIL I >= PmCnt;
END; {SortPMap}
PROCEDURE NoteIncs(PmCnt : Word); {.CP20}
LABEL NextTp;
VAR Tp : TraceRecPtr; I : Word;
BEGIN
Tp := AddrTraceTab(U);
WITH PMapP^, PMapC^ DO
WHILE Tp <> Nil DO WITH Tp^ DO BEGIN
I := 0;
WHILE I < PmCnt DO WITH PMRefs[I] DO BEGIN
IF PmDirN = TrName THEN
BEGIN
CMRefs[PmNdxC].CmNdxF := TrFill;
GOTO NextTp;
END;
Inc(I);
END;
NextTp:
Tp := AddrNxtTrace(U,Tp);
END;
END; {NoteIncs}
PROCEDURE SizeProcs(PmCnt : Word); {.CP16}
VAR Limit,i : LL;
BEGIN
Limit := (U^.UndNC + $F) AND $FFF0 + U^.ULCod;
i := 0;
WHILE i < PmCnt-1 DO WITH PMapP^.PmRefs[i], PMapC^ DO BEGIN
IF PmEntP <> $FFFF THEN
IF PmNdxC = PMapP^.PmRefs[i+1].PmNdxC
THEN PmSizP := PMapP^.PmRefs[i+1].PmEntP - PmEntP
ELSE WITH CmRefs[PmNdxC] DO
PmSizP := CmSegL + CmSegS - PmEntP;
Inc(i);
END;
WITH PMapP^.PmRefs[PmCnt-1] DO
IF PmEntP <> $FFFF THEN PmSizP := Limit - PmEntP;
END; {SizeProcs}
CONST RSiz = SizeOf(ReloListEntry); {.CP08}
VAR R : ReloListPtr; C : CSegMapTabPtr; Sh, Sp : SrcFilePtr;
TP : TraceRecPtr; P : ProcMapPtr; PE : ProcMapRecPtr;
Pn,Px,Cn,Cx,i : Integer; Cb,Rx,Sf,Sn,So : LL;
BEGIN
IF (PMapC <> Nil) OR (PMapP <> Nil) THEN CloseMapRefTab;
IF U <> Nil THEN
BEGIN
Cn := CountCMapSlots(U); {.CP42}
IF Cn > 0 THEN
BEGIN
C := AddrCMapTab(U);
R := AddrFixUps(U);
Rx:= 0;
Cb := (U^.UndNC + $F) AND $FFF0; {CodeBase}
CMapSiz := Cn * SizeOf(CMapRefRec);
GetMem(PMapC,CMapSiz);
FOR Cx := 0 TO Cn-1 DO
WITH PMapC^.CMRefs[Cx], C^.CSegMap[Cx] DO
BEGIN
CmNdxC := Cx; {index of CSegMap}
CmNdxF := 0; {offset to Main Source File Entry}
CmSegL := Cb; {LL to Segment Load Point}
CmSegS := CSegCnt;
CmNdxR := Rx; {index of ReloListEntry}
i := CSegRel DIV RSiz;
Rx := Rx + i; {Next Fixup index}
CmCntR := Rx - 1;
Cb := Cb + CSegCnt; {Next Seg Origin}
END; {CmNdxF can be refined for .OBJ,.INC files}
Sh := AddrSrcTabOff(U,0); Sp := Sh; Sf := 0; Sn := 0;
WHILE Sp <> Nil DO BEGIN
Inc(Sf);
IF Sp^.SrcFlag <> $05 THEN Inc(Sn);
Sp := AddrNxtSrc(U,Sp);
END; {Sn = Count of NON.OBJ files, Sf = Count of ALL files}
So := Sf - Sn; {.OBJ file count} Sp := Sh;
IF So > 0 THEN { we have .OBJ files to handle }
BEGIN
FOR i := 1 TO Sn DO Sp := AddrNxtSrc(U,Sp);
Cx := Cn - So; {1st CSeg from .OBJ}
FOR i := Cx TO Cn-1 DO
WITH PMapC^.CMRefs[i] DO
BEGIN
CmNdxF := FormLL(Sh,Sp);
Sp := AddrNxtSrc(U,Sp);
END;
END;
END;
Pn := CountPMapSlots(U); {.CP31}
IF Pn > 0 THEN
BEGIN
P := AddrPMapTab(U);
i := SizeOf(CSegMapRec);
PMapSiz := Pn * SizeOf(PMapRefRec);
GetMem(PMapP,PMapSiz);
FOR Px := 0 TO Pn-1 DO
WITH PMapP^.PMRefs[Px], P^.ProcMap[Px], PMapC^ DO
BEGIN
PmNdxP := Px;
PmDirN := $FFFF; { fill in later }
PmEntP := CSegJmp;
PmSizP := 0; { fill in later }
IF CSegOfs <> $FFFF THEN
BEGIN
PmNdxC := CSegOfs Div i;
IF CSegJmp <> $FFFF
THEN PmEntP := CSegJmp + CmRefs[PmNdxC].CmSegL;
END
ELSE PmNdxC := $FFFF; {Null Unit Init Proc}
END;
ScanHash(U^.UHash2); {Pick up PROC Names}
SortPMap(Pn); {Sort by Address}
NoteIncs(Pn); {Note .INC files in CMRefs}
SizeProcs(Pn); {Add Size info to PMRefs}
END;
END;
NMapP := Pn;
NMapC := Cn;
END;
{.CP15}
PROCEDURE FindFile(FName : String; VAR Finding : FStats);
CONST AttrMask = Dos.Archive + Dos.ReadOnly + Dos.SysFile;
VAR S : Dos.SearchRec; P : Dos.DirStr; N : Dos.NameStr; X : Dos.ExtStr;
BEGIN
Finding.Size := -1;
FSplit(FName,P,N,X);
IF (X = '') OR (X = '.') THEN X := '.TPU';
Finding.Path := FSearch(N + X,GetEnv('PATH'));
IF Finding.Path <> '' THEN
BEGIN
FindFirst(Finding.Path,AttrMask,S);
IF DosError = 0 THEN Finding.Size := S.Size
END
END;
PROCEDURE OpenUnit(Path : String); {.CP07}
BEGIN
{I-}
Assign(TPFile , Path);
Reset(TPFile,1);
{$I+}
END;
PROCEDURE CloseUnit; {.CP05}
BEGIN
{$I-} Close(TPFile); {$I+}
IF IOResult <> 0 THEN;
END;
PROCEDURE InitJobUnit(FilNam:Dos.PathStr); {.CP14}
VAR W : FStats;
BEGIN
DropJobUnit;
FindFile(FilNam,W);
IF (W.Size > 0) AND (W.Size < 65536) THEN
BEGIN
SizJobBfr := W.Size;
OpenUnit(W.Path);
GetMem(BufPtrJob,SizJobBfr);
BlockRead(TPFile,BufPtrJob^.BufByt,SizJobBfr);
CloseUnit;
END
END;
PROCEDURE DropJobUnit; {.CP11}
BEGIN
IF BufPtrJob <> Nil THEN
BEGIN
FreeMem(BufPtrJob,SizJobBfr);
CloseUnit;
END;
BufPtrJob := Nil;
SizJobBfr := 0;
CloseMapRefTab;
END;
BEGIN { UNIT INITIALIZATION CODE } {.CP12}
SizRefBfr := 0;
SizJobBfr := 0;
JobPath := '';
BufPtrRef := Nil;
BufPtrJob := Nil;
PMapC:= Nil; PMapP:= Nil; CloseMapRefTab; { Order Critical here }
END.